home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / mac / LOGIC Apple II 5.25" Library - ProDOS / PRO108.dsk / STARTUP.bas < prev   
BASIC Source File  |  2012-02-16  |  7KB  |  111 lines
  1. 0  REM PRODOS VER 3 FAMILY ROOTS. QUINSEPT, INC., P.O. BOX 216, LEXINGTON, MASS. 02173. COPYRIGHT (C) 1986 BY STEPHEN C. VORENBERG, ALL RIGHTS RESERVED.
  2. 1  PRINT  CHR$(4)"-EXTRA.VARIABLES
  3. 3  CLEAR :T$ = "": SPEED= 255
  4. 4  POKE 32,0: POKE 33,40: POKE 34,0: POKE 35,24
  5. 5  GOSUB 5100: GOSUB 850: PRINT  CHR$(4)"PR#"Q(43)
  6. 10  PRINT : PRINT : PRINT :A = (Q(22) -23)/2: HTAB A: INVERSE : PRINT "F A M I L Y   R O O T S": NORMAL 
  7. 15  PRINT :A$ = "TRIAL VERSION":A = (Q(22) - LEN(A$))/2: HTAB A: PRINT A$: PRINT 
  8. 20  PRINT : PRINT :A = (Q(22) -14)/2: HTAB A: PRINT "QUINSEPT, INC."
  9. 30  PRINT :A = (Q(22) -12)/2: HTAB A: PRINT "P.O. BOX 216": PRINT :A = (Q(22) -19)/2: HTAB A: PRINT "LEXINGTON, MA 02173"
  10. 35  PRINT :A$ = "(617) 641-2930":A = (Q(22) - LEN(A$))/2: HTAB A: PRINT A$: PRINT : PRINT : PRINT 
  11. 40  PRINT :A = (Q(22) -18)/2: HTAB A: PRINT "COPYRIGHT (C) 1986"
  12. 50  PRINT :A = (Q(22) -20)/2: HTAB A: PRINT "STEPHEN C. VORENBERG"
  13. 51 B =  PEEK( -16384): POKE  -16368,0
  14. 52 A =  PEEK( -16384): IF (A < >B)  OR (A < >32  AND A < >13)  THEN  POKE  -16368,0: GOTO 100
  15. 53 I = I +1: IF I <500  THEN 52
  16. 100  GOSUB 2500: GOSUB 12500
  17. 110  ONERR  GOTO 300
  18. 120  PRINT  CHR$(4)"OPENFRWHERE": PRINT  CHR$(4)"READFRWHERE": INPUT I: PRINT  CHR$(4)"CLOSE"
  19. 140  GOSUB 7100: PRINT  SPC( 14)"LOADING NEXT MODULE"
  20. 150  PRINT  CHR$(4)"RUNDIMMER"
  21. 300  PRINT  CHR$(4)"CLOSE":A =  PEEK(222): IF A = 5  OR A = 6  THEN  PRINT  CHR$(4)"RUNMANAGER"
  22. 310  GOTO 5920
  23. 510  RETURN 
  24. 850  PRINT : IF Q(43) = 0  OR Q(40)  THEN  HOME : RETURN 
  25. 855  PRINT  CHR$(12): RETURN 
  26. 2500  READ J:LI = 768
  27. 2510  FOR I = 0 TO J -1: READ A: POKE LI +I,A: NEXT : RETURN 
  28. 3000  DATA 84
  29. 3005  DATA 165,54,72,165,55,72,169,83,133,54,169,3,133,55
  30. 3010  DATA 162,0,32,117,253,141,9,192,160,2,138,141,5,192,145,105,141,4,192,200,169,0,141,5,192
  31. 3020  DATA 145,105,141,4,192,200,169,2,141,5,192,145,105,141,4,192,202,189,0,2,41,127,141,5,192
  32. 3030  DATA 157,0,2,141,4,192,224,0,208,237,141,8,192
  33. 3040  DATA 104,133,55,104,133,54,96
  34. 3100  DATA 12
  35. 3110  DATA "Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"
  36. 4200  IF  LEN(A$) <4  THEN 4215
  37. 4215 Z1 = 0:Z2 = 0:BB$ = " "
  38. 4216 AA$ = A$:Z = 0: GOSUB 7840: IF Z = 0  THEN 4250
  39. 4218  IF Z +1 > LEN(A$)  OR Z = 1  THEN 4250
  40. 4220 Z1 = Z:AA$ =  RIGHT$(A$, LEN(A$) -Z):Z = 0: GOSUB 7840: IF Z = 0  THEN 4250
  41. 4230  IF Z +1 > LEN(A$)  THEN 4250
  42. 4240 Z2 = Z +Z1: IF  LEN(A$) = Z2  THEN 4410
  43. 4245 AA$ =  RIGHT$(A$, LEN(A$) -Z2):Z = 0: GOSUB 7840: IF Z < >0  THEN 4410
  44. 4250  IF Z1 >0  AND Z2 >0  THEN 4300
  45. 4260  IF BB$ = " "  THEN BB$ = "/": GOTO 4216
  46. 4265  IF BB$ = "/"  THEN BB$ = "-": GOTO 4216
  47. 4270  GOTO 4410
  48. 4300  IF Z1 = Z2 -1  THEN 4410
  49. 4310 FL = 1:V1$ =  LEFT$(A$,Z1 -1):V2$ =  MID$ (A$,Z1 +1,Z2 -Z1 -1):V3$ =  RIGHT$(A$, LEN(A$) -Z2): IF BB$ < >"/"  AND BB$ < >"-"  THEN 4320
  50. 4315  IF Q(25)  THEN YN$ = V1$:V1$ = V2$:V2$ = YN$
  51. 4317  GOSUB 4500: GOTO 4400
  52. 4320 AA$ =  LEFT$(V1$,1): IF (AA$ > = "A"  AND AA$ < = "Z")  OR (AA$ > = "a"  AND AA$ < = "z")  THEN  GOSUB 4700: GOTO 4400
  53. 4330  GOSUB 4600
  54. 4400  IF   NOT FL  THEN 4410
  55. 4402  IF  VAL(V1$) <1  OR  VAL(V1$) >12  THEN  PRINT "THE MONTH IS OUT OF VALID RANGE."
  56. 4403  IF  VAL(V2$) <1  OR  VAL(V2$) >31  THEN  PRINT "THE DAY IS OUT OF VALID RANGE."
  57. 4405  IF Q(25)  THEN YN$ = V1$:V1$ = V2$:V2$ = YN$
  58. 4409 A$ = V1$ +V2$ +V3$
  59. 4410  RETURN 
  60. 4500  IF  LEN(V1$) >2  OR  LEN(V2$) >2  OR  LEN(V1$) >4  THEN FL = 0: RETURN 
  61. 4510  IF  LEN(V1$) = 2  THEN 4525
  62. 4515  IF  VAL(V1$) = 0  THEN V1$ = "??": GOTO 4525
  63. 4520  IF  VAL(V1$) <10  THEN V1$ = "0" +V1$
  64. 4525  GOSUB 4530: RETURN 
  65. 4530  IF  LEN(V2$) = 2  THEN 4550
  66. 4535  IF  VAL(V2$) = 0  THEN V2$ = "??": GOTO 4550
  67. 4540  IF  VAL(V2$) <10  THEN V2$ = "0" +V2$
  68. 4550  IF  LEN(V3$) = 4  THEN  RETURN 
  69. 4560  IF  LEN(V3$) = 2  AND  VAL(V3$) >0  THEN V3$ =  LEFT$(Q$(6),2) +V3$: RETURN 
  70. 4570  FOR I = 1 TO 4 - LEN(V3$):V3$ = "?" +V3$: NEXT : RETURN 
  71. 4600  IF  LEN(V1$) >2  OR  LEN(V3$) >4  THEN FL = 0: RETURN 
  72. 4610 YN$ = V1$:V1$ = V2$:V2$ = YN$: GOSUB 4700: RETURN 
  73. 4700  IF ( LEN(V2$) >2  AND ( LEN(V2$) >3  OR  RIGHT$(V2$,1) < >","))  OR  LEN(V3$) >4  OR  LEN(V3$) <2  THEN FL = 0: RETURN 
  74. 4702 I =  ASC(V3$): IF I <48  OR I >57  THEN  IF I < >63  THEN FL = 0: RETURN 
  75. 4705  IF  RIGHT$(V2$,1) = ","  THEN V2$ =  LEFT$(V2$,2)
  76. 4710 J = 3: IF  LEN(V1$) <3  THEN J =  LEN(V1$)
  77. 4715 A$ = "": FOR I = 1 TO J:B$ =  MID$ (V1$,I,1): IF  ASC(B$) >95  AND I = 1  THEN B$ =  CHR$( ASC(B$) -32)
  78. 4717  IF I >1  AND  ASC(B$) <96  THEN B$ =  CHR$( ASC(B$) +32)
  79. 4720 A$ = A$ +B$: NEXT :L = 0: FOR I = 1 TO 12: IF  LEFT$(A$,J) =  LEFT$(MT$(I),J)  THEN L = I:I = 12
  80. 4730  NEXT : IF L = 0  THEN V1$ = "??"
  81. 4740  IF L >0  THEN V1$ =  STR$(L): IF L <10  THEN V1$ = "0" +V1$
  82. 4750  GOSUB 4530: RETURN 
  83. 5100  ONERR  GOTO 5900
  84. 5105  DIM Q(84),Q$(50)
  85. 5110  PRINT  CHR$(4)"OPENCONFIGURATION": PRINT  CHR$(4)"READCONFIGURATION": FOR I = 1 TO 84: INPUT Q(I): NEXT : FOR I = 1 TO 6: INPUT Q$(I): NEXT : PRINT  CHR$(4)"CLOSE"
  86. 5120  POKE 216,0: RETURN 
  87. 5900 A =  PEEK(222): IF A < >5  AND A < >6  AND A < >8  THEN 5920
  88. 5910  PRINT "THERE IS NO CONFIGURATION FILE ON THE": PRINT "PROGRAM DISK.  PLEASE RUN THE 'MANAGER'": PRINT "PROGRAM.": END 
  89. 5920  PRINT "ERROR # " PEEK(222)" AT LINE " PEEK(218) +256 * PEEK(219)".": PRINT "PLEASE SEE DOS MANUAL.": END 
  90. 7100  GOSUB 850: FOR I = 1 TO 7: PRINT : NEXT : INVERSE : PRINT "PLEASE WAIT";: NORMAL : PRINT "....": PRINT 
  91. 7840 Z = 0:A =  LEN(AA$) - LEN(BB$): IF A <0  THEN  RETURN 
  92. 7880 I = A +1
  93. 7900  IF BB$ =  MID$ (AA$,I, LEN(BB$))  THEN Z = I
  94. 7920 I = I -1: IF I >0  THEN 7900
  95. 7940  RETURN 
  96. 12500  IF  PEEK(49040) + PEEK(49041) >10  THEN  RETURN 
  97. 12501  READ MT: DIM MT$(MT): FOR I = 1 TO MT: READ MT$(I): NEXT : IF Q(5)  THEN 12505
  98. 12502  IF   NOT Q(30)  THEN DY$ = Q$(3): GOTO 12550
  99. 12503  GOSUB 850: PRINT : PRINT "WHAT IS TODAY'S DATE? ";: CALL LI:DY$ = T$: GOTO 12550
  100. 12505  PRINT  CHR$(4)"IN#"Q(5): PRINT  CHR$(4)"PR#"Q(5): PRINT Q$(7);: INPUT DY$: PRINT  CHR$(4)"IN#0": IF Q(13)  THEN A$ =  MID$ (DY$,Q(13),Q(21))
  101. 12510 DY$ =  MID$ (DY$,Q(11),Q(12) -Q(11) +1): IF   NOT Q(13)  THEN DY$ = DY$ +"/" +Q$(3)
  102. 12520  IF Q(13)  THEN DY$ = DY$ +"/" +A$
  103. 12530  IF Q(25)  THEN DY$ =  MID$ (DY$,4,3) + MID$ (DY$,1,3) + RIGHT$(DY$,Q(21))
  104. 12540  PRINT  CHR$(4)"PR#"Q(43)
  105. 12550 A$ = DY$: GOSUB 4200: IF  LEN(A$) < >8  THEN  RETURN 
  106. 12555  FOR I = 1 TO 8: IF  MID$ (A$,I,1) <"0"  OR  MID$ (A$,I,1) >"9"  THEN I = 8: NEXT : RETURN 
  107. 12560  NEXT :I =  VAL( MID$ (A$,1,2)):J =  VAL( MID$ (A$,3,2)):K =  VAL( MID$ (A$,7)): IF   NOT Q(25)  THEN X = I:I = J:J = X
  108. 12570  IF K >100  THEN K = K - INT(K/100) *100
  109. 12575  POKE 49040,(J -8 * INT(J/8)) *32 +I: POKE 49041,K *2 + INT(J/8)
  110. 12590  RETURN 
  111. 20000  RUN